//=============================================================================
///	S-Expression
//=============================================================================

#ifndef	__SEXP_H__
#define	__SEXP_H__

#include "stream.h"
#include "hashtable.h"
#include <assert.h>
#include <stddef.h>  // for size_t

#ifdef __cplusplus
extern "C" {
#endif

//=============================================================================
// Type definition

typedef int SFixnum;

/// S-Expression
typedef union {
	SFixnum i;

	struct STypeInfo** p;
	struct Cell* cell;
	struct Symbol* symbol;
	struct String* string;
	struct SHash* hash;
	struct Port* port;

	struct Function* function;
	struct Closure* closure;
} SExp;

typedef struct STypeInfo {
	const char* name;
	void (*write)(SExp s, int b_escape, StreamBase* strm);
	SExp (*apply)(SExp self, int s, int sargnum);
} STypeInfo;

typedef struct Cell {
	const STypeInfo* typeinfo;
	SExp head;
	SExp tail;
} Cell;

typedef struct Symbol {
	const STypeInfo* typeinfo;
	unsigned int hash;
	char name[1];
} Symbol;

typedef struct String {
	const STypeInfo* typeinfo;
	size_t len;
	char buf[1];
} String;

typedef struct SHash {
	const STypeInfo* typeinfo;
	HashTable ht;
} SHash;

typedef struct Port {
	const STypeInfo* typeinfo;
	StreamBase* strm;
} Port;


void* smalloc(size_t size, int atomic);
void sfree(void* ptr);
void smem_set_filnalizer(SExp s, void (*func)(SExp));
SExp error(const char* msg, ...);

extern const STypeInfo TUnknown;
extern const STypeInfo TFixnum;
extern const STypeInfo TCell;
extern const STypeInfo TSymbol;
extern const STypeInfo TString;
extern const STypeInfo TSHash;
extern const STypeInfo TPort;

SExp type_error(SExp s, const STypeInfo* t);

SExp cons(SExp a, SExp d);
void rplaca(SExp s, SExp a);
void rplacd(SExp s, SExp d);

void init_symbol_table(void);
void dump_symbol_table_info(void);
SExp intern(const char* name);
SExp gensym(void);

SExp gen_string(const char* str, size_t len);

SExp sread(struct StreamBase* strm);
void swrite(SExp s, int b_escape, struct StreamBase* strm);

SExp make_hash_table(void);
void hash_table_put(SExp h, SExp key, SExp val);
int hash_table_exists(SExp h, SExp key);
SExp hash_table_get(SExp h, SExp key);

SExp gen_port(StreamBase* sb);

SExp cant_apply(SExp self, int s, int argnum);


#define _MAKE_OTHER_VALUE(x)		(((x)<<2) | 2)
static __inline SExp MAKE_OTHER(int x)		{ SExp s; s.i = _MAKE_OTHER_VALUE(x); return s; }
extern SExp sNIL;		///< end of list: ()
extern SExp sFALSE;		///< false
extern SExp sTRUE;		///< true
extern SExp sUNDEF;		///< undefined
#define	sEOF		MAKE_OTHER(5)		///< end of file

static const STypeInfo* type_of(SExp s);
static SExp type_check(SExp s, const STypeInfo* t);

static SExp fixnum2s(int i);
static SFixnum S2FIXNUM(SExp s);
static SExp ptr2s(const void* p);
static int ptrp(SExp s);
static STypeInfo* SPTRTYPE(SExp s);
static void* S2PTR(SExp s);
static int eq(SExp s1, SExp s2);
static int nullp(SExp s);
static int consp(SExp s);
static int falsep(SExp s);
static int truep(SExp s);
static int symbolp(SExp s);

static SExp CAR(SExp s);
static SExp CDR(SExp s);
static SExp CADR(SExp s);
static SExp CDDR(SExp s);
static SExp CADDR(SExp s);
static SExp CDDDR(SExp s);


SExp list(int n, SExp array[]);
SExp list1(SExp);
SExp list2(SExp, SExp);
SExp list3(SExp, SExp, SExp);
SExp list4(SExp, SExp, SExp, SExp);
int length(SExp ls);
SExp nreverse(SExp s);
SExp assoc(SExp key, SExp alist);

unsigned int strhash(const char* str);



//=============================================================================
// inline definition

static __inline const STypeInfo* type_of(SExp s) {
	switch (s.i & 3) {
	default: case 0:
		return *s.p;
	case 1: case 3:
		return &TFixnum;
	case 2:
		return &TUnknown;
	}
}

static __inline SExp type_check(SExp s, const STypeInfo* t)		{ return type_of(s) != t ? type_error(s, t) : s; }

static __inline SExp fixnum2s(int i)		{ SExp s; s.i = (i << 1) | 1; return s; }
static __inline SFixnum S2FIXNUM(SExp s)	{ assert(type_of(s) == &TFixnum); return s.i >> 1; }
static __inline SExp ptr2s(const void* p)	{ SExp s; s.p = (STypeInfo**)p; return s; }
static __inline int ptrp(SExp s)			{ return (s.i & 3) == 0; }
static __inline STypeInfo* SPTRTYPE(SExp s)	{ return *s.p; }
static __inline void* S2PTR(SExp s)			{ assert(ptrp(s)); return (void*)s.p; }
static __inline int eq(SExp s1, SExp s2)	{ return s1.i == s2.i; }
static __inline int nullp(SExp s)			{ return eq(s, sNIL); }
static __inline int consp(SExp s)			{ return ptrp(s) && SPTRTYPE(s) == &TCell; }
static __inline int falsep(SExp s)			{ return eq(s, sFALSE); }
static __inline int truep(SExp s)			{ return !eq(s, sFALSE); }
static __inline int symbolp(SExp s)			{ return ptrp(s) && SPTRTYPE(s) == &TSymbol; }
static __inline const char* S2CSTR(SExp s)	{ assert(type_of(s) == &TString); return s.string->buf; }

static __inline SExp CAR(SExp s)			{ assert(consp(s)); return s.cell->head; }
static __inline SExp CDR(SExp s)			{ assert(consp(s)); return s.cell->tail; }
static __inline SExp CADR(SExp s)			{ return CAR(CDR(s)); }
static __inline SExp CDDR(SExp s)			{ return CDR(CDR(s)); }
static __inline SExp CADDR(SExp s)			{ return CAR(CDDR(s)); }
static __inline SExp CDDDR(SExp s)			{ return CDR(CDDR(s)); }
static __inline SExp CADDDR(SExp s)			{ return CAR(CDDDR(s)); }
static __inline SExp CDDDDR(SExp s)			{ return CDR(CDDDR(s)); }

//=============================================================================

#ifdef __cplusplus
} //extern "C"
#endif

#endif
